home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / MEDICAL / 1999.ZIP / NTERNIST.BAS < prev    next >
BASIC Source File  |  1984-04-04  |  25KB  |  363 lines
  1. 10 REM  INTERNIST, COPYRIGHT (C)1984, N-SQUARED COMPUTING, SILVERTON, OREGON 97381. TELEPHONE (503) 873-5906.....SOURCE CODE FOR COMPILED VERSION
  2. 13 ON ERROR GOTO 3020
  3. 14 DEFINT I,J,V,H,C,L
  4. 15 DIM VC%(65),P%(331,1),RC%(20),PD%(331),P2%(331),A$(65),S$(20),SH$(20),DS%(481,9),DL%(48,92),BP$(34),A(21),T%(48),DISINDEX%(331),REF%(20)
  5. 16 GOSUB 8000
  6. 54 OPEN "SCRN:" FOR OUTPUT AS #2
  7. 55 GOTO 1840
  8. 60 PRINT#2,TAB(34);"*************":PRINT#2, TAB(34);"* INTERNIST *":PRINT#2, TAB(34);"*************":RETURN
  9. 64 AA$=SPACE$(239):FOR I=4 TO 19 STEP 3:LOCATE I,1:PRINT#2,AA$:NEXT:RETURN
  10. 65 AA$=SPACE$(79):FOR I=VSTART TO VSTOP:LOCATE I,1:PRINT#2,AA$:NEXT:RETURN
  11. 71 COLOR 8,7:RETURN
  12. 72 LOCATE 1,1,0:PRINT#2,:RETURN
  13. 73 COLOR 31,0:RETURN
  14. 74 COLOR 15,0:RETURN
  15. 75 COLOR 7,0:RETURN
  16. 76 TL%=LEN(TITLE$)/2:LOCATE 1,38-TL%,0:PRINT#2, CHR$(201)+STRING$(LEN(TITLE$)+4,205)+CHR$(187):LOCATE 2,38-TL%,0:PRINT#2, CHR$(185)+STRING$(LEN(TITLE$)+4,32)+CHR$(204):LOCATE 3,38-TL%,0:PRINT#2, CHR$(200)+STRING$(LEN(TITLE$)+4,205)+CHR$(188)
  17. 77 GOSUB 74:LOCATE 2,(81-LEN(TITLE$))/2,0:PRINT#2, TITLE$;:GOSUB 75:IF MENU$="SY" OR MENU$="EA" OR MENU$="PA" OR MENU$="SE" THEN GOSUB 100:GOTO 79
  18. 78 LOCATE 2,1,0:PRINT#2, CHR$(201)+STRING$(36-TL%,205):LOCATE 2,44+TL%-LEN(TITLE$) MOD 2,0:PRINT#2, STRING$(35-TL%+LEN(TITLE$) MOD 2,205)+CHR$(187):FOR I=3 TO 23:LOCATE I,1,0:PRINT#2, CHR$(186):LOCATE I,79,0:PRINT#2, CHR$(186):NEXT
  19. 79 LOCATE 24,1:PRINT#2,CHR$(200)+STRING$(77,205)+CHR$(188);:GOSUB 72:LOCATE 22,1:IF MENU$="SY" OR MENU$="EA" OR MENU$="PA" OR MENU$="SE" THEN PRINT#2,CHR$(201)+STRING$(77,205)+CHR$(187);:RETURN ELSE PRINT#2,CHR$(204)+STRING$(77,205)+CHR$(185);:RETURN
  20. 80 G$=INKEY$:IF G$="" THEN 80 ELSE G=VAL(G$):G%=ASC(G$)
  21. 82 IF G%<123 AND G%>96 THEN G$=CHR$(G%-32):G%=ASC(G$)
  22. 84 RETURN
  23. 85 LOCATE 23,40:AA$=SPACE$(39):PRINT#2,AA$:LOCATE 23,40:RETURN
  24. 90 SIDE%=3-SIDE%:RETURN
  25. 95 MEM=FRE(0):IF MEM>5000 THEN RETURN ELSE MEM=FRE(G$):RETURN
  26. 100 LOCATE 2,1:PRINT#2,CHR$(201)+STRING$(36-TL%,205);:LOCATE,44+TL%-LEN(TITLE$) MOD 2:PRINT#2,STRING$(35-TL%+LEN(TITLE$) MOD 2,205)+CHR$(187):LOCATE 3,1:PRINT#2,CHR$(208);:LOCATE,79:PRINT#2,CHR$(208)
  27. 101 LOCATE 22,1:PRINT#2,CHR$(186)+STRING$(77,32)+CHR$(186)
  28. 102 LOCATE ,1:PRINT#2,CHR$(186)+STRING$(77,32)+CHR$(186):RETURN
  29. 110 CLS:TITLE$=O$:GOSUB 72:GOSUB 76:GOSUB 72:LOCATE 11,26:PRINT#2, "Will you be using a printer":LOCATE 12,30:PRINT#2, "this session (Y/N)?":LOCATE 12,50,0
  30. 112 GOSUB 80:IF G$<>"Y" AND G$<>"N" THEN BEEP:GOTO 112 ELSE PR$=G$:RETURN
  31. 120 IF (W<>0 AND J3=0) OR (W=0 AND J4=0) THEN BEEP:RETURN 2320
  32. 124 RETURN
  33. 130 NU$="                <N>ext                 ":RETURN
  34. 135 G$="":G$=INKEY$:IF G$<>CHR$(13) THEN 135 ELSE RETURN
  35. 140 IF CSRLIN=>22 AND SIDE%=1 THEN IF PP%=1 THEN LOCATE 6,40:RETURN ELSE LOCATE TV%,40:RETURN
  36. 144 RETURN
  37. 200 RE%=P2%(GG%):IF PP%=1 THEN RE%=P%(GG%,0):GOTO 215
  38. 210 IF W<>0 THEN RE%=PD%(GG%)
  39. 215 IF PP%=2 THEN RE%=GG%
  40. 220 GOSUB 1270:OPEN "SYMPTOM1.BIN" AS #1 LEN=42:FIELD #1, 42 AS RS$:GET #1,RE%:A$=RS$:CLOSE #1
  41. 222 FOR I=1 TO 21:A(I)=CVI(MID$(A$,(I-1)*2+1,2)):NEXT
  42. 230 GOSUB 72:GOSUB 74:LOCATE 7,25:PRINT#2, "Insert reference diskette and":LOCATE ,22:PRINT#2, "press letter of disk drive selected.":GOSUB 75
  43. 232 GOSUB 80:IF G%<65 OR G%>90 THEN BEEP:GOTO 232
  44. 236 X$=G$
  45. 240 GOSUB 72:LOCATE 7,1:AA$=SPACE$(159):PRINT#2, AA$:IF QQ%<>79 THEN GOSUB 72:LOCATE 4,3:PRINT#2,"Disease/Condition: ";:GOSUB 74:PRINT#2,RD.GOOD$:GOSUB 75:LOCATE 5,3:PRINT#2, "Symptoms:":LOCATE 7,5:GOSUB 350:RETURN
  46. 250 CLS:GOSUB 74:LOCATE 12,30:PRINT#2, "Printing reference data":GOSUB 75:LOCATE 12
  47. 260 CLOSE #2:OPEN "LPT1:" FOR OUTPUT AS #2:PRINT#2,"Disease/Condition: ";RD.GOOD$:PRINT#2,:PRINT#2,"Symptoms:":PRINT#2,:GOSUB 350:GOSUB 600:RETURN
  48. 310 IF (J3=0 AND W<>0) OR (J4=0 AND W=0) THEN 335
  49. 332 GOSUB 74:LOCATE ,TB%:GOSUB 140:PRINT#2,B$:L=-1:GOSUB 75:RETURN
  50. 335 GOSUB 74:LOCATE ,TB%:GOSUB 140:PRINT#2,C$:L=-1:GOSUB 75:RETURN
  51. 350 FOR IZ=2 TO 21:RE=A(IZ):IF RE=0 THEN IZ=21:GOTO 380
  52. 370 GOSUB 420
  53. 380 NEXT:RETURN
  54. 420 RT$="TOTAL.RAN":SR%=(RE-INT(RE/1000)*1000):FI$=X$+":"+RT$:OPEN FI$ AS #1 LEN=215:FIELD #1, 215 AS RT.TEMP$:GET #1,SR%:A$=RT.TEMP$:CLOSE #1:H=5
  55. 432 PL$="~":PL%=INSTR(A$,PL$):A$=LEFT$(A$,PL%-1)
  56. 434 IF CSRLIN>19 THEN 435 ELSE 438
  57. 435 GOSUB 72:GOSUB 74:LOCATE 23,26:PRINT#2,"Press <SPACEBAR> to continue.":GOSUB 75
  58. 436 G$=INKEY$:IF G$="" THEN 436 ELSE GOSUB 72:LOCATE 23,25:AA$=SPACE$(38):PRINT#2,AA$:GOSUB 72:VSTART=7:VSTOP=21:GOSUB 65:LOCATE 7,5
  59. 438 GOSUB 1780:RETURN
  60. 440 PRINT#2, "The following conditions/diseases have the following number of symptoms":PRINT#2, "in common with those symptoms presented by the subject:":PRINT#2, :PRINT#2, " ****CONDITION/DISEASE****         ****NUMBER OF SYMPTOMS IN COMMON****"
  61. 445 PRINT#2,
  62. 460 FOR I=1 TO L2:RE%=P%(I,0):GOSUB 1270:PRINT#2, USING "###";I;:PRINT#2,". ";RD.GOOD$;:SP$=SPACE$(15):PRINT#2,SP$;:PRINT#2,USING "##";P%(I,1):NEXT:RETURN
  63. 480 GOSUB 72:GOSUB 64:LOCATE 5,25:PRINT#2, "Do you wish to...":LOCATE 10,34:PRINT#2, "<D>isplay":LOCATE 12,38:PRINT#2,"or":LOCATE 14,34:PRINT#2, "<P>rint out":IF FR%=1 THEN FR%=0:LOCATE 19,39:PRINT#2,"...the reference ?":GOTO 484
  64. 482 IF FR%=0 THEN LOCATE 19,40:PRINT#2, "...the analysis ?"
  65. 484 GOSUB 74:LOCATE 23,40:PRINT#2,AL$;:GOSUB 75
  66. 500 GOSUB 80:IF G%<>27 AND G%<>8 AND G%<>13 AND G$<>"P" AND G$<>"D" THEN BEEP:GOTO 500 ELSE RETURN
  67. 520 CLS:GOSUB 72:GOSUB 74:LOCATE 8,21:PRINT#2, "--Make sure the printer is turned on--":LOCATE 12,24:PRINT#2, "Press <SPACEBAR> to continue, or"
  68. 525 LOCATE 14,31:PRINT#2, "<ESC> for Main Menu":GOSUB 75:GOSUB 80:IF G%=27 OR G%=8 THEN 1860 ELSE RETURN
  69. 530 GOSUB 60:FOR I=1 TO 4:PRINT#2,:NEXT:PRINT#2,TAB(40-LEN(TI$)/2);TI$;:PRINT#2,:PRINT#2,:PRINT#2,:PRINT#2,"The subject presented these symptoms:":PRINT#2,:H=7:QQ%=79:FOR CO=1 TO J:A$=MID$(S$(CO),6):GOSUB 1760:NEXT:PRINT#2,:PRINT#2,:PRINT#2,:RETURN
  70. 540 PRINT#2,"The subject may be suffering from one of the following:":PRINT#2,:IF (W=0 AND J4=0) OR (W<>0 AND J3=0) THEN PRINT#2,E$:RETURN
  71. 560 IF IE=1 THEN 580
  72. 570 IF J3>J4 THEN A=J4 ELSE A=J3
  73. 580 FOR I=1 TO A:RE%=PD%(I):GOSUB 1270
  74. 590 PRINT#2,USING"###";I;:PRINT#2,". ";RD.GOOD$:NEXT:RETURN
  75. 600 PRINT#2,:PRINT#2,:FOR I=1 TO 79:PRINT#2,"=";:NEXT:PRINT#2,"=":PRINT#2,CHR$(12);:CLOSE #2:OPEN "SCRN:" FOR OUTPUT AS #2:RETURN
  76. 630 FOR I=1 TO L2:P%(I,0)=0:P%(I,1)=0:NEXT:FOR I=1 TO J3:PD%(I)=0:NEXT:FOR I=1 TO J4:P2%(I)=0:NEXT:FOR I=1 TO J6:REF%(I)=0:NEXT:RETURN
  77. 640 ZZ$="":FOR I=0 TO 48:IF T%(I)=VAL(MID$(SH$(IE),3)) THEN ZZ$="L":TI=I:I=48:RETURN
  78. 650 NEXT:ZZ$="S":RETURN
  79. 660 L=L+1:Q$="":IF ZZ$="S" THEN 700
  80. 670 IF L>92 THEN L=-1:RETURN
  81. 680 IF DL%(TI,L)=0 THEN L=-1:RETURN
  82. 690 DN%=DL%(TI,L):GOTO 730
  83. 700 IF L>9 THEN L=-1:RETURN
  84. 710 IF DS%(VAL(MID$(SH$(IE),3)),L)=0 THEN L=-1:RETURN
  85. 720 DN%=DS%(VAL(MID$(SH$(IE),3)),L)
  86. 730 IF IE>1 THEN GOSUB 770
  87. 740 IF Q$="Y" THEN 660
  88. 750 GOSUB 760:GOTO 660
  89. 760 L2=L2+1:P%(L2,0)=DN%:P%(L2,1)=1:RETURN
  90. 770 Q$="":FOR I=1 TO L2:IF DN%=P%(I,0) THEN GOSUB 800
  91. 780 IF Q$="Y" THEN I=L2
  92. 790 NEXT:RETURN
  93. 800 Q$="Y":P%(I,1)=P%(I,1)+1:RETURN
  94. 810 DU=1
  95. 820 DU=DU*2:IF DU<=L2 THEN 820
  96. 830 DU=INT((DU-1)/2):IF DU=0 THEN RETURN
  97. 840 FOR NU=1 TO L2-DU:JU=NU
  98. 850 LU=JU+DU:IF P%(JU,1)>=P%(LU,1) THEN 870
  99. 860 X1=P%(JU,1):X0=P%(JU,0):P%(JU,1)=P%(LU,1):P%(JU,0)=P%(LU,0):P%(LU,1)=X1:P%(LU,0)=X0:JU=JU-DU:IF JU>0 THEN 850
  100. 870 NEXT:GOTO 830
  101. 880 J3=J3+1:PD%(J3)=RE%:RETURN
  102. 900 J$="":IF W<>0 THEN 930
  103. 910 FOR I=1 TO J3:IF RE%=PD%(I) THEN I=J3:J$="F":J4=J4+1:P2%(J4)=RE%:RETURN
  104. 920 NEXT:J$="N":RETURN
  105. 930 FOR I=1 TO J4:IF RE%=P2%(I) THEN I=J4:J$="F":GOSUB 880:RETURN
  106. 940 NEXT:J$="N":RETURN
  107. 950 NM$="":GOSUB 85:GOSUB 74:PRINT NU$;:GOSUB 75
  108. 952 GOSUB 80:NM$=G$:G%=ASC(NM$):RETURN
  109. 960 NU$="  Enter number to delete (<A>=all):":GOSUB 1420:IF ASC(NM$)=13 AND NM%=0 THEN RETURN 1860
  110. 970 IF G%=32 OR NM%>CO THEN BEEP:GOTO 960
  111. 980 IF (ASC(NM$)=8 OR ASC(NM$)=27) AND C=2 THEN C=0:GOTO 960
  112. 990 IF ASC(NM$)=27 OR ASC(NM$)=8 THEN RETURN
  113. 1000 IF G%=65 OR G%=97 THEN FOR I=1 TO J:S$(I)="":SH$(I)="":NEXT:NM%=1:J=1
  114. 1010 IF NM%=1 AND J=1 THEN S$(J)="":SH$(J)="":J=0:GOSUB 64:LOCATE 12,30:GOSUB 74:PRINT "All symptoms deleted":LOCATE 13,24:PRINT AMM$:GOSUB 75:GOSUB 135:RETURN 1860
  115. 1020 IF NM%=J THEN S$(J)="":SH$(J)="":J=J-1:VSTART=VC%(NM%):VSTOP=21:GOSUB 65:RETURN
  116. 1030 FOR I=NM% TO J-1:S$(I)=S$(I+1):SH$(I)=SH$(I+1):NEXT:S$(J)="":SH$(J)="":J=J-1:IF NM%=1 THEN GOSUB 64:CO=0:LOCATE 5:GOSUB 1670:RETURN
  117. 1040 VSTART=VC%(NM%):VSTOP=21:CO=NM%-1:GOSUB 65:LOCATE VC%(NM%):GOSUB 1670:RETURN
  118. 1050 L=L+1:IF ZZ$="S" AND L>9 THEN L=-1:LOCATE ,TB%:GOSUB 74:PRINT#2,B$:GOSUB 75:RETURN
  119. 1060 IF ZZ$="S" THEN 1100
  120. 1070 IF L>92 THEN L=-1:LOCATE ,TB%:GOSUB 140:GOSUB 74:PRINT#2,B$:GOSUB 75:RETURN
  121. 1080 IF DL%(TI,L)=0 THEN GOSUB 310:RETURN
  122. 1090 RE%=DL%(TI,L):GOTO 1120
  123. 1100 IF DS%(VAL(MID$(SH$(IE),3)),L)=0 THEN GOSUB 310:RETURN
  124. 1110 RE%=DS%(VAL(MID$(SH$(IE),3)),L)
  125. 1120 IF IE>1 THEN GOSUB 900:GOTO 1140
  126. 1130 IF IE=1 THEN GOSUB 880:GOSUB 1270:GOTO 1155
  127. 1140 IF J$="N" THEN 1050
  128. 1150 GOSUB 1270
  129. 1155 IF V%<TV% THEN V%=TV%
  130. 1157 TB%=(SIDE%-1)*40+1
  131. 1160 IF W<>0 THEN A=J3 ELSE A=J4
  132. 1210 IF A=0 THEN LOCATE ,TB%:GOSUB 140:PRINT#2,C$:RETURN
  133. 1220 LOCATE ,TB%,0:PRINT#2,USING"###";A;:PRINT#2," ";RD.GOOD$:GOSUB 1540:GOTO 1250
  134. 1250 IF CSRLIN>21 THEN GOSUB 90:IF SIDE%=1 THEN RETURN ELSE V%=TV%:TB%=(SIDE%-1)*40+1:GOTO 1260
  135. 1260 LOCATE V%:GOTO 1050
  136. 1270 OPEN "DISEASE.RAN" AS #1 LEN=32:FIELD #1, 32 AS RD$:GET #1, RE%:RD.GOOD$=RD$:CLOSE #1:RETURN
  137. 1280 OPEN FI$ FOR INPUT AS #1
  138. 1282 INPUT#1, R$:R=VAL(R$)
  139. 1284 FOR I= 1 TO R:INPUT#1,A$(I):NEXT:CLOSE#1:RETURN
  140. 1300 LASTCO=CO
  141. 1305 CO=CO+1:XC=CO:IF CO>18 THEN XC=10
  142. 1310 IF CO>R THEN RETURN
  143. 1320 VC%(CO)=CSRLIN:A$=MID$(A$(CO),6):GOSUB 1760:IF CSRLIN>=20 AND FI$="SKIN" THEN RETURN
  144. 1330 IF CSRLIN>=21 THEN RETURN
  145. 1340 GOTO 1305
  146. 1370 LOCATE 23,2:PRINT " <ESC>=Prior Menu  ";CR$;"=Main Menu ";CHR$(186);:LOCATE 22,39:PRINT CHR$(203);:LOCATE 24,39:PRINT CHR$(202);:RETURN
  147. 1420 GOSUB 85:NM%=0:NM$="":GOSUB 74:PRINT NU$;:GOSUB 75
  148. 1430 NM$=INKEY$:IF NM$="" THEN 1430
  149. 1432 IF NM$="0" AND C=0 THEN BEEP:GOTO 1430
  150. 1440 G%=ASC(NM$):IF G%<>13 AND G%<>27 AND G%<>8 AND G%<>32 AND G%<48 THEN BEEP:GOTO 1430
  151. 1450 IF G%=65 OR G%=97 THEN RETURN
  152. 1460 IF G%>57 THEN BEEP:GOTO 1430
  153. 1470 IF G%=13 AND C=0 THEN NM%=0:GOTO 1530
  154. 1480 IF G%=13 AND C=2 THEN NM%=N2%:C=0:GOTO 1530
  155. 1490 IF G%=8 OR G%=27 OR G%=32 THEN RETURN
  156. 1510 NM%=VAL(NM$):PRINT NM$;:IF C=0 THEN N2%=NM%:C=2:GOTO 1430
  157. 1520 IF C=2 THEN NM%=N2%*10+NM%:C=0
  158. 1530 RETURN
  159. 1540 V%=CSRLIN:RETURN
  160. 1550 GG$=""
  161. 1560 G$=INKEY$:IF G$="" THEN 1560 ELSE G=VAL(G$):G%=ASC(G$)
  162. 1562 IF (G%>96 AND G%<123) AND PP%=2 THEN G%=G%-32:G$=CHR$(G%):GOTO 1650
  163. 1563 IF PP%=2 AND MV%=0 THEN 1570
  164. 1565 IF G%>57 THEN G$="":BEEP:GOTO 1550
  165. 1570 IF G%=13 OR G%=8 OR G%=27 THEN 1600
  166. 1580 IF G%<48 THEN G$="":BEEP:GOTO 1550
  167. 1590 IF G<0 OR G>9 THEN G$="":BEEP:GOTO 1550
  168. 1600 IF G%=13 AND LEN(GG$)<>0 THEN RETURN
  169. 1610 IF G%=13 AND LEN(GG$)=0 THEN GG$="RET":RETURN
  170. 1620 IF (G%=27 OR G%=8) AND LEN(GG$)=0 THEN GG$="ESC":RETURN
  171. 1630 IF G%=8 AND LEN(GG$)<=1 THEN LOCATE ,E%:PRINT#2," ";:LOCATE ,E%:G$="":GOTO 1550
  172. 1640 IF G%=8 THEN GG$=LEFT$(GG$,(LEN(GG$)-1)):LOCATE ,E%+LEN(GG$):PRINT#2, " ";:LOCATE ,E%+LEN(GG$):GOTO 1560
  173. 1650 PRINT#2, G$;:GG$=GG$+G$:IF LEN(GG$)>ML% OR VAL(GG$)>MV% THEN BEEP:LOCATE ,E%:PRINT#2,"    ";:LOCATE ,E%:G$="":GOTO 1550
  174. 1655 IF MV%=331 AND LEN(GG$)=3 THEN RETURN
  175. 1660 GOTO 1560
  176. 1670 CO=CO+1:IF CO>J THEN CO=CO-1:RETURN
  177. 1680 VC%(CO)=CSRLIN:A$=MID$(S$(CO),6):H=5:GOSUB 1760:IF CSRLIN>=20 THEN RETURN
  178. 1690 GOTO 1670
  179. 1710 FOR I=1 TO J2-1:IF J2=1 THEN Q$="Y":RETURN
  180. 1720 IF NM%=RC%(I) THEN Q$="N"
  181. 1730 NEXT:IF Q$<>"N" THEN Q$="Y"
  182. 1740 IF Q$="N" THEN RC%(J2)=0:J2=J2-1
  183. 1750 RETURN
  184. 1760 LOCATE VC%(CO),1,0
  185. 1770 PRINT#2,USING"##";CO;:PRINT#2,". ";
  186. 1780 N=QQ%-H:S=1:IF LEN(A$)<=N THEN LOCATE ,H:PRINT#2,A$:RETURN
  187. 1800 FOR I=N TO S STEP -1:T$=MID$(A$,I,1):IF T$=" " OR T$="/" OR T$="-" THEN TI%=I:I=S-1
  188. 1810 NEXT:LOCATE ,H:IF N>LEN(A$) THEN PRINT#2, MID$(A$,S):RETURN
  189. 1820 LOCATE ,H:PRINT#2,MID$(A$,S,TI%-S+1):S=TI%+1:N=TI%+QQ%-H:IF N>LEN(A$) THEN LOCATE ,H:PRINT#2,MID$(A$,S):RETURN
  190. 1830 GOTO 1800
  191. 1840 VN$="DSHORT.BIN":DEF SEG:BLOAD VN$,VARPTR(DS%(0,0)):VN$="DLONG.BIN":DEF SEG:BLOAD VN$,VARPTR(DL%(0,0)):FI$="SEQNAM":GOSUB 1280:FOR I=1 TO 34:BP$(I)=A$(I):NEXT:GOSUB 110:GOTO 1860
  192. 1850 LOCATE 21,28:GOSUB 74:BEEP:PRINT#2,"That was the 20th symptom":FOR I!=1 TO 8000!:NEXT:LOCATE 21,22:PRINT#2,AMM$:GOSUB 75:GOSUB 135
  193. 1860 GOSUB 95:MENU$="MM":FR%=0:C=0:R=0:CO=0:NM$="":NM%=0:QQ%=77:PP%=0:CLS:GOSUB 72:TITLE$=">>>>>     M A I N  M E N U     <<<<<":GOSUB 76:LOCATE 8,32:PRINT "<1> Enter Symptoms";
  194. 1870 LOCATE 10,32:PRINT "<2> Edit Symptoms":LOCATE 12,32:PRINT "<3> Run Diagnoses":LOCATE 14,32:PRINT "<4> Reference a disease":LOCATE 16,32:PRINT "<5> Quit";:IF DC=1 AND PR$<>"N" THEN PRINT ", or ":LOCATE 18,32:PRINT "<6> Print Results"
  195. 1890 GOSUB 72:GOSUB 74:LOCATE 23,22:PRINT#2,AN$;:GOSUB 75
  196. 1892 GOSUB 80:IF G<1 OR G>5+DC THEN BEEP:GOTO 1892
  197. 1894 IF DC=0 OR (DC=1 AND G<>6) THEN GOSUB 630
  198. 1900 IF G$="1" AND J=20 THEN BEEP:LOCATE 20,23:GOSUB 74:PRINT "MAXIMUM NUMBER OF SYMPTOMS INPUTTED";:FOR I!=1 TO 8000!:NEXT:GOSUB 75:LOCATE 20,21:PRINT#2,SPC(40):GOTO 1890
  199. 1910 GOSUB 75:DC=0:G$="P":ON G GOTO 1920,2120,2200,6000,5000,2861
  200. 1920 GOSUB 95:MENU$="BP":CO=0:XC=0:FOR I=1 TO J2:RC%(I)=0:NEXT:J2=0:CLS:GOSUB 72:TITLE$=" >> BODY PART/FUNCTION/PRODUCT MENU << ":GOSUB 76:FOR I=1 TO 34:ITRUNC$=MID$(STR$(I),2,LEN(STR$(I))):HT%=INT(I/12)*25+6:IF I=23 THEN HT%=56
  201. 1922 IF I<10 THEN HT%=7
  202. 1924 V%=(I MOD 11)+5:IF I MOD 11=0 THEN V%=V%+11
  203. 1925 IF I=34 THEN V%=17
  204. 1926 LOCATE V%,HT%
  205. 1928 PRINT "<";ITRUNC$;"> ";BP$(I):NEXT:NU$="  Enter number of desired selection:":GOSUB 1370
  206. 1930 GOSUB 72:GOSUB 1420:IF G%=32 OR G%=65 THEN BEEP:GOTO 1930
  207. 1940 IF NM%>34 THEN BEEP:GOTO 1930
  208. 1950 IF G%=27 OR G%=8 THEN 1860
  209. 1960 IF G%=13 AND NM%=0 THEN 1860
  210. 1970 GOSUB 95:MENU$="SY":CO=0:CLS:GOSUB 72:TITLE$=BP$(NM%):GOSUB 76:NU$=" <SPACEBAR>=Scroll  Enter selections:":FI$=LEFT$(BP$(NM%),4):IF BP$(NM%)="BREASTS" THEN FI$="BREASTS"
  211. 1975 GOSUB 1280
  212. 1980 LOCATE 5:H=5:GOSUB 1300
  213. 1990 GOSUB 1370
  214. 2000 GOSUB 1420:IF G%=65 OR G%=97 THEN BEEP:GOTO 2000
  215. 2010 IF G%<>32 THEN 2050
  216. 2020 IF G%=32 AND CO>=R THEN GOSUB 64:CO=0:XC=0:LOCATE 5:GOSUB 1300:GOTO 2000
  217. 2040 IF G%=32 THEN GOSUB 64:GOTO 1980
  218. 2050 IF G%=13 AND NM%=0 THEN 1860
  219. 2060 IF (G%=27 OR G%=8) AND NM%<>0 THEN NM%=0:C=0:GOTO 2000
  220. 2070 IF G%=27 OR G%=8 THEN 1920
  221. 2080 IF NM%>CO OR NM%>R OR NM%<=LASTCO THEN BEEP:GOTO 2000
  222. 2090 J2=J2+1:RC%(J2)=NM%:GOSUB 1710:IF Q$="N" THEN Q$="Y":BEEP:GOTO 1990
  223. 2100 GOSUB 74:LOCATE VC%(NM%):TC=CO:CO=NM%:A$=MID$(A$(CO),6):H=5:GOSUB 1760:CO=TC:GOSUB 75:J=J+1:S$(J)=A$(NM%):SH$(J)=LEFT$(S$(J),5):IF J=20 THEN 1850
  224. 2110 GOTO 1990
  225. 2120 GOSUB 95:MENU$="SE":CLS:QQ%=77:TITLE$="   >>>>    SYMPTOM EDITOR    <<<<    ":GOSUB 72:GOSUB 76:GOSUB 1370:IF J=0 THEN LOCATE 12,31:GOSUB 74:PRINT "NO SYMPTOMS TO EDIT":BEEP:FOR I!=1 TO 8000!:NEXT:GOSUB 75:GOTO 1860
  226. 2130 LOCATE 5:GOSUB 1670:DC=0
  227. 2140 NU$=" <SPACEBAR>=Scroll  <D>elete symptoms":GOSUB 950:IF J=0 THEN 1860
  228. 2150 IF G%<>13 AND G%<>27 AND G%<>8 AND G%<>68 AND G%<>100 AND G%<>32 THEN BEEP:GOTO 2140
  229. 2160 IF G%=68 OR G%=100 THEN GOSUB 960:GOTO 2140
  230. 2170 IF G%=27 OR G%=8 OR G%=13 THEN 1860
  231. 2180 IF G%=32 AND CO>=J THEN GOSUB 64:CO=0:XC=0:LOCATE 5:GOSUB 1670:GOTO 2140
  232. 2190 IF G%=32 THEN GOSUB 64:LOCATE 5:GOSUB 1670:GOTO 2140
  233. 2200 GOSUB 95:MENU$="AM":CLS:GOSUB 72:PP%=0:QQ%=77:TITLE$="    >>>>>    ANALYSIS MENU    <<<<<    ":GOSUB 76:GOSUB 1370:IF J=0 THEN BEEP:GOSUB 74:LOCATE 12,29:PRINT "NO SYMPTOMS TO ANALYZE":GOSUB 75:FOR I!=1 TO 8000!:NEXT:GOTO 1860
  234. 2210 LOCATE 7,24:PRINT "Do you wish to run a...":LOCATE 12,31:PRINT "<P>ooled Analysis":LOCATE 14,37:PRINT "or an":LOCATE 16,31:PRINT "<E>xclusive Analysis"
  235. 2220 GOSUB 72:LOCATE 23,40:GOSUB 74:PRINT#2,AL$;:GOSUB 80:IF G$<>"E" AND G$<>"P" AND G%<>13 AND G%<>27  AND G%<>8 THEN G$="":BEEP:GOTO 2220 ELSE GOSUB 75
  236. 2230 IF G%=13 OR G%=27 OR G%=8 THEN 1860
  237. 2235 GOSUB 630:DC=0
  238. 2240 IF G$="P" THEN 2790
  239. 2250 MEM=FRE(G$):MENU$="EA":CLS:GOSUB 72:TITLE$=H$:GOSUB 76:C=0:QQ%=77:PP%=0:FR%=0:GOSUB 1370:SIDE%=1:DC=0
  240. 2260 IE=0:J3=0:J4=0:L=-1:IE=IE+1:W=(IE/2)-INT(IE/2):GOSUB 640:GOSUB 72:LOCATE 5,1:H=1:GOSUB 74:A$=MID$(S$(IE),6):GOSUB 1780:GOSUB 75:H=5:GOSUB 1540:TV%=V%+1
  241. 2270 LOCATE TV%:GOSUB 1050:IF NM$="R" OR NM$="r" THEN FR%=1:GOTO 2400
  242. 2280 IF NM$="R" THEN FR%=1:GOTO 2400
  243. 2290 NU$="    <N>ext               <R>eference  ":IF L<>-1 XOR J3+J4=0 THEN NU$=K$
  244. 2295 IF (L=-1 AND J3+J4=0) OR (W=0 AND J4=0) OR (W<>0 AND J3=0) THEN GOSUB 130
  245. 2300 IF PP%=1 THEN NU$=K$
  246. 2310 IF PP%=1 AND RE%=0 THEN NU$="                <R>eference            "
  247. 2320 GOSUB 950:IF NM$<>"R" AND NM$<>"N" AND G%<>13 AND G%<>27 AND G%<>8 AND G%<>32 THEN BEEP:GOTO 2320
  248. 2335 IF (NM$="N" AND PP%=1) OR (PP%=1 AND RE%=0 AND G%=32) OR (G%=32 AND L=-1) THEN BEEP:GOTO 2320
  249. 2350 IF PP%=1 AND G%=32 THEN 2950
  250. 2370 IF G%=27 OR G%=8 THEN GOSUB 630:GOTO 2200
  251. 2380 IF NM$<>"R" THEN 2620
  252. 2395 IF NM$="R" THEN GOSUB 120
  253. 2400 IF NM$="R" THEN NU$=" Please enter number of disease:":FR%=1
  254. 2410 NM$="":CO=J3:IF J4<=J3 AND J4<>0 THEN CO=J4
  255. 2420 GOSUB 72:GOSUB 85:E%=72:ML%=3:MV%=331:GOSUB 74:PRINT NU$;:GOSUB 75:GOSUB 1550:IF GG$="RET" THEN 1860
  256. 2430 IF GG$="ESC" THEN 2290
  257. 2440 GG%=VAL(GG$):IF GG%<=0 OR (PP%=1 AND GG%>CO-1) OR (PP%=0 AND GG%>CO) THEN BEEP:GOTO 2420
  258. 2470 IF PR$="N" THEN 2530
  259. 2475 IF PP%=2 THEN CLS:TITLE$=I$:GOSUB 72:GOSUB 76:GOSUB 1370
  260. 2480 GOSUB 72:GOSUB 85:GOSUB 480:QQ%=77:IF ASC(G$)=13 THEN 1860
  261. 2485 IF PP%=2 AND (ASC(G$)=27 OR ASC(G$)=8) THEN 6000
  262. 2490 IF PP%=1 AND (ASC(G$)=27 OR ASC(G$)=8) THEN 2570
  263. 2500 IF ASC(G$)=27 OR ASC(G$)=8 THEN GOSUB 64:NM$="R":GOTO 2760
  264. 2510 IF G$="D" THEN CLOSE #2:OPEN "SCRN:" FOR OUTPUT AS #2:GOTO 2530
  265. 2520 GOSUB 520:QQ%=79:CLS:GOTO 2540
  266. 2530 QQ%=77:CLS:TITLE$=I$:GOSUB 72:GOSUB 76:GOTO 2550
  267. 2540 CLOSE #2:OPEN "LPT1:" FOR OUTPUT AS #2:PRINT#2, TAB(22);I$:PRINT#2,:PRINT#2,:PRINT#2,:CLOSE #2:OPEN "SCRN:" FOR OUTPUT AS #2
  268. 2550 GOSUB 200:CLOSE #2:OPEN "SCRN:"FOR OUTPUT AS #2:IF  X$="A" THEN LOCATE ,26:GOSUB 74:PRINT#2, "Reinsert program diskette and":LOCATE ,28:PRINT#2,"press ";CR$;" to continue.":GOSUB 75:GOSUB 135:GOTO 2565
  269. 2560 IF X$<>"A" THEN LOCATE ,28:GOSUB 74:PRINT#2, "Press ";CR$;" to continue.":GOSUB 75:GOSUB 135
  270. 2565 IF PP%=2 THEN 1860
  271. 2570 CLS:IF PP%=1 AND NN>=L2 THEN NN=INT(L2/32)*32+1
  272. 2580 IF PP%=1 THEN SIDE%=1:TITLE$=F$:GOSUB 72:GOSUB 76:GOSUB 1370:GOSUB 72:LOCATE 4,2:PRINT#2,PA$;PA$
  273. 2590 IF PP%=1 THEN GOSUB 74:LOCATE 23,40:PRINT K$:GOSUB 75:LOCATE 6:GOTO 2880
  274. 2600 SIDE%=1:TITLE$=H$:GOSUB 72:GOSUB 76:GOSUB 1370:IF L=-1 THEN NM$="N":GOTO 2650
  275. 2610 LOCATE 5:H=1:GOSUB 74:A$=MID$(S$(IE),6):GOSUB 1780:GOSUB 75:H=5:GOTO 2270
  276. 2620 IF G%=13 THEN 1860
  277. 2630 IF G%=32 THEN VSTART=TV%:VSTOP=21:GOSUB 65:GOTO 2270
  278. 2645 IF NM$="N" AND L<>-1 THEN 2290
  279. 2650 IF IE<J AND NM$="N" THEN 2750
  280. 2662 IF IE=J AND NM$="N" THEN 2666
  281. 2666 GOSUB 64:LOCATE 5,27:PRINT "That was the last symptom."
  282. 2670 GOSUB 85:GOSUB 72:LOCATE 10,27:PRINT#2,"You may now ...":LOCATE 13,31:PRINT#2,"<1> Print final analysis":LOCATE 15,31:PRINT#2, "<2> Go to analysis menu":LOCATE 17,31:PRINT#2,"<3> Review analysis"
  283. 2675 GOSUB 1370:GOSUB 74:GOSUB 72:LOCATE 23,40:PRINT#2,AN$;:GOSUB 75
  284. 2680 GOSUB 80:IF G<>1 AND G<>2 AND G<>3 AND G%<>13 AND G%<>27 AND G%<>8 THEN G$="":BEEP:GOTO 2680
  285. 2690 IF G=3 OR G%=27 OR G%=8 THEN 2250
  286. 2700 IF G=2 THEN 2200
  287. 2710 IF G%=13 THEN 1860
  288. 2730 IF G=1 AND PR$="N" THEN 2680
  289. 2740 IF G=1 THEN TI$=H$:GOSUB 72:GOSUB 520:CLOSE #2:OPEN "LPT1:" AS #2:GOSUB 530:GOSUB 540:PRINT#2, :GOSUB 600:GOSUB 630:DC=0:GOTO 1860
  290. 2750 GOSUB 64:IE=IE+1:W=IE/2-INT(IE/2)
  291. 2760 GOSUB 72:LOCATE 5:H=1:GOSUB 74:A$=MID$(S$(IE),6):GOSUB 1780:GOSUB 75:H=1:GOSUB 1540:TV%=V%+1:LOCATE TV%:GOSUB 640:SIDE%=1:IF L<>-1 THEN 2270
  292. 2770 IF W<>0 THEN J3=0:GOTO 2270 ELSE J4=0:GOTO 2270
  293. 2790 GOSUB 95:MENU$="PA":CLS:TITLE$=F$:GOSUB 72:GOSUB 76:GOSUB 1370:GOSUB 72:LOCATE 23,40:GOSUB 74:PRINT#2,"         Running analysis on         ":GOSUB 75:L=-1:L2=0:Q$="":IE=1:QQ%=77:PP%=0:FR%=0:LOCATE 5,2
  294. 2792 GOSUB 73:PRINT#2, CHR$(254)+CHR$(16);:GOSUB 75:SIDE%=1:TB%=1
  295. 2795 LOCATE ,5:H=5:FV%=CSRLIN:A$=MID$(S$(IE),6):GOSUB 1780:PRINT#2,:GOSUB 640:GOSUB 660
  296. 2800 IE=IE+1:W=IE/2-INT(IE/2):IF IE>J THEN 2830
  297. 2810 IF CSRLIN>19 THEN GOSUB 64:LOCATE 5
  298. 2820 NV%=CSRLIN:LOCATE FV%,2:PRINT#2,"  ":LOCATE NV%,2:GOSUB 73:PRINT#2,CHR$(254)+CHR$(16);:GOSUB 75:LOCATE ,5:H=5:A$=MID$(S$(IE),6):FV%=CSRLIN:GOSUB 1780:PRINT#2,:Q$="":L=-1:GOSUB 640:GOSUB 660:GOTO 2800
  299. 2830 LOCATE FV%,2:PRINT#2,"  ":GOSUB 85:GOSUB 73:PRINT#2,"  Now running sort":GOSUB 75:GOSUB 810:GOSUB 64:GOSUB 85:IF PR$="N" THEN 2870
  300. 2860 GOSUB 480
  301. 2861 IF G$="P" THEN CLS:TI$=F$:GOSUB 72:GOSUB 520:CLOSE #2:OPEN "LPT1:" FOR OUTPUT AS #2:GOSUB 530:GOSUB 440:PRINT#2,:GOSUB 600:GOSUB 630:DC=0:GOTO 1860
  302. 2862 IF G%=27 OR G%=8 THEN 2200
  303. 2864 IF G%=13 THEN 1860
  304. 2870 DC=1:GOSUB 64:GOSUB 72:LOCATE 4,2:PRINT#2,PA$;" ";PA$:GOSUB 1370:GOSUB 85:GOSUB 74:PRINT#2,K$:GOSUB 75:LOCATE 6,1,0:FOR NN=1 TO L2 STEP 32
  305. 2880 FOR IP=NN TO NN+31
  306. 2890 RE%=P%(IP,0):IF RE%=0 THEN GOSUB 74:LOCATE ,TB%:GOSUB 140:PRINT#2,AC$:GOSUB 75:TP%=IP:IP=NN+31:GOTO 2920
  307. 2895 TB%=(SIDE%-1)*39+1
  308. 2900 GOSUB 1270:LOCATE ,TB%:PRINT#2,USING"###";IP;:PRINT#2," ";RD.GOOD$;:LOCATE ,TB%+36:PRINT#2,USING"##";P%(IP,1)
  309. 2905 IF CSRLIN>21 THEN GOSUB 90:IF SIDE%=2 THEN LOCATE 6:TB%=(SIDE%-1)*39+1
  310. 2910 IF IP=L2 AND L2 MOD 32=0 THEN GOSUB 73:LOCATE 5,20:PRINT#2,AC$:RE%=0:GOSUB 75
  311. 2920 NEXT:IF RE%=0 THEN GOSUB 74:GOSUB 85:PRINT#2,"               <R>eference           ";:GOSUB 75
  312. 2940 GOSUB 80:IF G%<>32 AND G$<>"R" AND G%<>27 AND G%<>8 AND G%<>13 THEN G$="":BEEP:GOTO 2940
  313. 2950 IF G%=32 AND RE%=0 THEN BEEP:GOTO 2940
  314. 2960 IF G%=32 THEN VSTART=6:VSTOP=21:GOSUB 65:LOCATE 6:NEXT
  315. 2970 IF G%=13 THEN 1860
  316. 2980 IF G%=27 OR G%=8 THEN 2200
  317. 2990 IF RE%=0 THEN IP=TP%
  318. 3000 IF G$="R" THEN J3=IP:J4=J3:FR%=1:NM$="R":PP%=1:GOTO 2400
  319. 3010 GOTO 2880
  320. 3020 BEEP:CLOSE #2:OPEN "SCRN:" FOR OUTPUT AS #2:GOSUB 73:V=CSRLIN:FOR I=18 TO 58 STEP 20:LOCATE V,I:PRINT#2,"ERROR";:NEXT:PRINT#2,:GOSUB 75:GOSUB 74
  321. 3140 LOCATE ,17:PRINT#2,"Error number";ERR;"just occurred in line number";ERL
  322. 3160 PRINT#2,:LOCATE ,23,0:PRINT#2,AMM$:GOSUB 135:GOSUB 75:RESUME 1860
  323. 5000 CLS:END
  324. 6000 PP%=2:CLS:GOSUB 72:TITLE$="Choosing a disease to reference":GOSUB 76
  325. 6010 GOSUB 72:GOSUB 1370:GOSUB 85:GOSUB 74:GOSUB 72:LOCATE 23,40:PRINT " Enter first 3 letters of disease:";:GOSUB 75:ML%=3:MV%=0:E%=74:GOSUB 1550:IF LEN(GG$)<>3 THEN BEEP:GOTO 6010
  326. 6020 IF GG$="RET" OR GG$="ESC" THEN 1860
  327. 6025 LOCATE 6
  328. 6027 J6=0
  329. 6030 FOR I=1 TO 331
  330. 6040 IF DISINDEX%(I)=(ASC(LEFT$(GG$,1))-65)*26^2+(ASC(MID$(GG$,2,1))-65)*26+ASC(RIGHT$(GG$,1))-65 THEN J6=J6+1:REF%(J6)=I:RE%=I:GOSUB 1270:LOCATE ,28:PRINT USING "##";J6;:PRINT ". "RD.GOOD$
  331. 6050 NEXT:IF CSRLIN=6 THEN BEEP:LOCATE 12,12:PRINT "No disease found which starts with those 3 letters.":FOR I!=1 TO 8000!:NEXT:CLS:GOSUB 76:GOTO 6010
  332. 6060 GOSUB 72:GOSUB 85:GOSUB 74:PRINT " Enter number of desired disease:";:GOSUB 75:MV%=J6:ML%=2:E%=73:GOSUB 1550:IF GG$="ESC" THEN 6000
  333. 6065 IF VAL(GG$)<=0 THEN BEEP:GOTO 6060
  334. 6070 IF GG$="RET" THEN 1860
  335. 6075 MENU$="EA":FR%=1
  336. 6080 GG%=REF%(VAL(GG$)):GOTO 2470
  337. 8000 CLS:KEY OFF
  338. 8010 TITLE$="Internist"
  339. 8020 FOR I=1 TO 8
  340. 8030 LOCATE I,36-((8-I)^2.18/2):PRINT LEFT$(TITLE$,I)
  341. 8040 NEXT
  342. 8050 COLOR 15,0:LOCATE 10,36:PRINT"Internist":COLOR 7,0
  343. 8060 FOR I=1 TO 8
  344. 8070 LOCATE 11+I,(I^2.15/2)+36:PRINT RIGHT$(TITLE$,9-I)
  345. 8080 NEXT
  346. 8090 V=20:H=1
  347. 8100 LOCATE 20,1,0:PRINT STRING$(80,196)
  348. 8110 LOCATE V+1,H:PRINT"(C)1984 by
  349. 8120 LOCATE V+2,H:PRINT"N-Squared Computing"
  350. 8130 LOCATE V+3,H:PRINT"5318 Forest Ridge Road"
  351. 8140 LOCATE V+4,H:PRINT"Silverton, Oregon  97381. Telephone (503) 873-5906";
  352. 8150 OPEN "DL%CODES.TXT" FOR INPUT AS #1:FOR I=0 TO 48:INPUT #1,T%(I):NEXT:CLOSE #1
  353. 8155 BLOAD "DISINDEX.BIN",VARPTR(DISINDEX%(0))
  354. 8157 OPEN "STRINGFI.TXT" FOR INPUT AS #1:INPUT #1, AN$,AL$,CR$,AMM$,E$,B$,C$,F$,AC$,H$,I$,K$,O$,PA$:CLOSE #1
  355. 8160 LOCATE 19,35:PRINT "Disclaimer"
  356. 8170 LOCATE 21,1:PRINT "N-Squared Incorporated makes no warranties, either expressed or implied, with"
  357. 8180 LOCATE 22,1:PRINT "respect to the quality or performance of this product. It is sold 'as is' and"
  358. 8190 LOCATE 23,1:PRINT "the entire risk as to its quality and performance is with the buyer. N-Squared"
  359. 8200 LOCATE 24,1:PRINT "Incorporated further assumes no liability nor responsibility for adverse conse-";
  360. 8210 LOCATE 25,1:PRINT "quences resulting from reliance on the representations of this product.";
  361. 8220 RETURN
  362. erse conse-";
  363. 8210 LOCATE 25,1:PRINT "quences resulting from reliance on the representations